home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / morse.el < prev    next >
Lisp/Scheme  |  1996-01-20  |  3KB  |  122 lines
  1. ;;; morse.el --- Convert text to morse code and back.
  2.  
  3. ;; Copyright (C) 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Code:
  25.  
  26. (defvar morse-code '(("a" . ".-")
  27.              ("b" . "-...")
  28.              ("c" . "-.-.")
  29.              ("d" . "-..")
  30.              ("e" . ".")
  31.              ("f" . "..-.")
  32.              ("g" . "--.")
  33.              ("h" . "....")
  34.              ("i" . "..")
  35.              ("j" . ".---")
  36.              ("k" . "-.-")
  37.              ("l" . ".-..")
  38.              ("m" . "--")
  39.              ("n" . "-.")
  40.              ("o" . "---")
  41.              ("p" . ".--.")
  42.              ("q" . "--.-")
  43.              ("r" . ".-.")
  44.              ("s" . "...")
  45.              ("t" . "-")
  46.              ("u" . "..-")
  47.              ("v" . "...-")
  48.              ("w" . ".--")
  49.              ("x" . "-..-")
  50.              ("y" . "-.--")
  51.              ("z" . "--..")
  52.              ;; Punctuation
  53.              ("=" . "-...-")
  54.              ("?" . "..--..")
  55.              ("/" . "-..-.")
  56.              ("," . "--..--")
  57.              ("." . ".-.-.-")
  58.              (":" . "---...")
  59.              ("'" . ".----.")
  60.              ("-" . "-....-")
  61.              ("(" . "-.--.-")
  62.              (")" . "-.--.-")
  63.              ;; Numbers
  64.              ("0" . "-----")
  65.              ("1" . ".----")
  66.              ("2" . "..---")
  67.              ("3" . "...--")
  68.              ("4" . "....-")
  69.              ("5" . ".....")
  70.              ("6" . "-....")
  71.              ("7" . "--...")
  72.              ("8" . "---..")
  73.              ("9" . "----."))
  74.   "Morse code character set.")
  75.  
  76. (defun morse-region (beg end)
  77.   "Convert all text in a given region to morse code."
  78.   (interactive "r")
  79.   (if (integerp end)
  80.       (setq end (copy-marker end)))
  81.   (save-excursion
  82.     (let ((sep "")
  83.       str morse)
  84.       (goto-char beg)
  85.       (while (< (point) end)
  86.     (setq str (downcase (buffer-substring (point) (1+ (point)))))
  87.     (cond ((looking-at "\\s-+")
  88.            (goto-char (match-end 0))
  89.            (setq sep ""))
  90.           ((setq morse (assoc str morse-code))
  91.            (delete-char 1)
  92.            (insert sep (cdr morse))
  93.            (setq sep "/"))
  94.           (t
  95.            (forward-char 1)
  96.            (setq sep "")))))))
  97.  
  98. (defun unmorse-region (beg end)
  99.   "Convert morse coded text in region to ordinary ASCII text."
  100.   (interactive "r")
  101.   (if (integerp end)
  102.       (setq end (copy-marker end)))
  103.   (save-excursion
  104.     (let (str paren morse)
  105.       (goto-char beg)
  106.       (while (< (point) end)
  107.     (if (null (looking-at "[-.]+"))
  108.         (forward-char 1)
  109.       (setq str (buffer-substring (match-beginning 0) (match-end 0)))
  110.       (if (null (setq morse (rassoc str morse-code)))
  111.           (goto-char (match-end 0))
  112.         (replace-match
  113.           (if (string-equal "(" (car morse))
  114.               (if (setq paren (null paren)) "(" ")")
  115.             (car morse)) t)
  116.         (if (looking-at "/")
  117.         (delete-char 1))))))))
  118.  
  119. (provide 'morse)
  120.  
  121. ;;; morse.el ends here
  122.